(require* sketch/parse/rule/util)

(defrule line-contains
	"line = line, line"
;    (test (= 0 1))
    (declare (salience 100))
	?f1 <- (shape (name "Line") (obj ?l1))
    ?f2 <- (shape (name "Line") (obj ?l2&~?l1))
	(test (call ShapePredicate containsLineLine ?l1 ?l2))
;    (test (call ShapePredicate joins ?l1 ?l2))
    =>
    (printout "recognize line = line, line (contains)")
    (bind ?sh (new Line))
    (?sh setP1 (?l1 getP1))
    (?sh setP2 (?l1 getP2))
    (retract ?f1)
    (retract ?f2)
    (assert (shape
            (name "Line")
            (obj ?sh)
            (children ?l1 ?l2)))
    (recognize ?sh (list-children (create$ ?l1 ?l2))))

(defrule line-overlapped
    "line = line, line"
    (declare (salience 90))
    ?f1 <- (shape (name "Line") (obj ?l1))
    ?f2 <- (shape (name "Line") (obj ?l2&~?l1))
    (test (call ShapePredicate overlappedLineLine ?l1 ?l2))
    =>
    (printout "recognize line = line, line (overlapped)")
    (bind ?sh (new Line))
    (?sh setP1 (?l1 getEndPointTo ?l2))
    (?sh setP2 (?l2 getEndPointTo ?l1))
    (retract ?f1)
    (retract ?f2)
    (assert (shape
            (name "Line")
            (obj ?sh)
            (children ?l1 ?l2)))
    (recognize ?sh (list-children (create$ ?l1 ?l2))))

(defrule line-joins
    "line = line, line"
    (declare (salience 80))
    ?f1 <- (shape (name "Line") (obj ?l1))
    ?f2 <- (shape (name "Line") (obj ?l2&~?l1))
    (test (call ShapePredicate joinsLineLine ?l1 ?l2))
;	(test (call ShapePredicate parallelLineLine ?l1 ?l2))
    (test (call ShapePredicate reverseLineLine
            (?l1 getLineStartWith (?l1 getCommonPointTo ?l2))
            (?l2 getLineStartWith (?l2 getCommonPointTo ?l1))))
    =>
    (printout "recognize line = line, line (joins)")
    (bind ?sh (new Line))
    (?sh setP1 (?l1 getEndPointTo ?l2))
    (?sh setP2 (?l2 getEndPointTo ?l1))
    (retract ?f1)
    (retract ?f2)
    (assert (shape
            (name "Line")
            (obj ?sh)
            (children ?l1 ?l2)))
    (recognize ?sh (list-children (create$ ?l1 ?l2))))
